home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 5
/
The 640 Meg Shareware Studio CD-ROM Volume V (Data Express)(1994).ISO
/
amiga
/
rfs156.lha
/
rexx
/
RFSfileLIST.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-03-25
|
9KB
|
252 lines
/**/
v="$VER: RFSFileList Rexx FileList Creator Williamson 54.05"
debug=0
system="Amiga ECS" /* Your system name and address here */
listnote="Available files, updated "date()
default=" Sorry, there is no description for this area"||cr||cr
/* ^^ spaces required! */
/* You must create these files */
bbslist="BBS:TEXT/bbsn.list" /* filearea config */
htext="CFG:filelistheader.txt" /* System header */
areatext='area.text' /* area description */
/* output files - edit names to suit */
allfileslist="MAIL:FILELISTS/01670104.LST" /* Output File List */
allfilesarc ="MAIL:FILELISTS/01670104.LHA" /* Archived Normal List */
filesbbs ="files.bbs" /* area desc and files */
/* WB2 List Lformat parameters */
EXCLUDE='~(area.text|files.bbs|LZTEMP.#?|.info)' /* LIST exclusion parameters */
LFMT_LIST='"%-20N%7L %-9D %C"' /* all files list */
LFMT_BBS='"%-30N %C"' /* areas.bbs */
FLLEN=77 /* list line length */
MARGINALL=39 /* margin for LFMT_LIST - wraptofile prepends a space */
/* used internally */
fileslist="OS4:TMP/ALST-"Pragma('ID') /* temporary all file */
tmpbbs="T:MLST-"Pragma('ID') /* temporary area list */
script="RFSfileList";ver="v"||right(v,5);fmvers=script ver
cr='0a'x;lf='0a'x
CSI='9b'x;AOFF=CSI||'0m';BOLD=CSI||'1m';ULINE=CSI||'4m';ITALICS=CSI||'3;40m'
if ~show("L", "rexxsupport.library") then
if ~addlib("rexxsupport.library", 0, -30, 0) then do
say "Couldn't access support.library !"
exit 20
end
options results
options failat 20
signal on halt
signal on ioerr
signal on break_c
signal on break_d
call close('STDOUT')
call open('STDOUT',"CON:0/10/640/100/"script ver"/CLOSE",'w')
call close('STDIN')
call open('STDIN','*','R')
/* Start Area Processing */
if ~open('dlst',bbslist, 'R') then do
call writeln(STDOUT, "Couldn't open fileareas list" bbslist)
signal cleanup
end
if show('p',"ROOFLOG") then address 'ROOFLOG' 'logline' left(time(),5) script': Updating FILE Listing'
call writeln(STDOUT, lf||ITALICS||" "fmvers||lf||" by Robert Williamson 1:167/104.0@fidonet"||AOFF)
/* Start Area Processing */
call writeln(STDOUT, 'Reading file area configuration')
area=1
do while ~eof('dlst')
call writech(STDOUT,'.')
blstln=readln('dlst')
if blstln="" then iterate
parse var blstln Number.area '"' Path.area '"' '"' Name.area '"'
area=area+1
end /*eof*/
call close('dlst')
areas=area-1
call writeln(STDOUT,'Found 'areas' file areas')
/* open all file listing, put title, date and system header */
call writeln(STDOUT,ULINE||"Generating All Files Listing for "system||AOFF||cr)
if debug then call writeln(STDOUT,'Adding date/version header to 'fileslist)
open('tbl', fileslist, 'W')
call writech('tbl'," "fmvers" by Robert Williamson 1:167/104.0@fidonet"||cr)
call writech('tbl'," FileListing for" system delstr(space(date(), 1, "-"), 8, 2) time()||cr ||cr)
close('tbl')
if ~exists('htext') then do
if debug then call writeln(STDOUT,'Adding headerfile' htext 'to 'fileslist)
com='Type >> "'fileslist'" "'htext'"'
address COMMAND com
end
do area=1 to areas
if area ~= 0 then do
areadir=addslash(dequote(Path.area))
if debug then call writeln(STDOUT,'Updating area' Name.area)
call listandsort(areadir,areadir||filesbbs,LFMT_BBS)
call addareatext(areadir,areadir||filesbbs,areatext,areadir||filesbbs,'prepend')
call writeln(STDOUT,'Appending 'areadir Number.area Name.area' to 'fileslist)
tbuf=CR||CR
tbuf=tbuf'╒══════════════════════════╤═════════════════════╤══════════════════════════╕'||CR
tbuf=tbuf'│ ░░░░░▒▒▒▒▒▓▓▓▓▓█████▓▓▓▓▓│'center("AREA: "Number.Area,21)'│▓▓▓▓▓█████▓▓▓▓▓▒▒▒▒▒░░░░░ │'||CR
tbuf=tbuf'├────────────────┬─────────┴─────────────────────┴─────────┬────────────────┤'||CR
tbuf=tbuf'│ ░░░░░▒▒▒▒▒▓▓▓▓▓│'center(Name.Area,41)'│▓▓▓▓▓▒▒▒▒▒░░░░░ │'||CR
tbuf=tbuf'╘════════════════╧═════════════════════════════════════════╧════════════════╛'||CR
if debug then call writeln(STDOUT,'Adding Area Banner to 'fileslist)
if ~open('tbl', fileslist, 'A') then do
call writeln(STDOUT,'Cannot append Area Header to 'fileslist)
signal cleanup
end
call writech('tbl',tbuf)
close('tbl')
drop tbuf
if exists(areadir||areatext) then do
if debug then call writeln(STDOUT,'Adding Area description to 'fileslist)
com='Type >> "'fileslist'" "'areadir||areatext'"'
address COMMAND com
end
call listandsort(areadir,tmpbbs,LFMT_LIST)
if ~open('ifn',tmpbbs,'R') then do
call writeln(STDOUT,'wraptofile:Cannot open 'tmpbbs)
signal cleanup
end
if ~open('ofn',fileslist,'A') then do
call writeln(STDOUT,'wraptofile:Cannot append Area List to 'fileslist)
signal cleanup
end
do while ~eof('ifn')
line=readln('ifn')
if left(line,1) ~= " " then call writech('ofn',' 'wrap_line(line,FLLEN,MARGINALL))
else call writech('ofn',line||cr)
end /*eof */
call close('ifn')
call close('ofn')
end
end
address COMMAND 'Copy' fileslist allfileslist
address COMMAND 'FileNote "'allfileslist'" "'listnote'"'
call writeln(STDOUT,'Archiving 'allfileslist' as 'allfilesarc)
address COMMAND 'lha -2 u "'allfilesarc'" "'allfileslist'"'
address COMMAND 'FileNote "'allfilesarc'" "'listnote'"'
call writeln(STDOUT,' File Listing completed')
cleanup:
call delete(fileslist)
call delete(tmpbbs)
exit 0
listandsort:
/* list <tdir> with <lfmt> and sort to <tfile> */
tdir=arg(1);tfile=arg(2);lfmt=arg(3)
las='PIPE LIST 'tdir||exclude' FILES NOHEAD LFORMAT 'lfmt' | SORT In: 'tfile
address command las
return 0
/* prepend area.text to files.bbs */
/* addareatext(areadir,files.bbs,area.text,output) */
/* addareatext(areadir,files.bbs,area.text,output,where) */
/* where= append or prepend(DEFAULT) */
/* example: */
/* call addareatext(Path.area,availlist,areatext,availlist) */
addareatext:
descfile=addslash(dequote(arg(1)))||arg(3)
inlist=arg(2);tolist=arg(4);where=arg(5)
if ~exists(inlist) then do
call writeln(STDOUT,'addareatext: cannot find 'inlist)
return 20
end
if ~exists(descfile) then do
call writeln(STDOUT,'addareatext: cannot find 'descfile' using 'default)
if where='append' then do
call open('ds',descfile,'A')
call writech('ds',default)
end;else do
call open('ds',descfile,'W')
call writech('ds',default)
end
call close('ds')
end
if where='append' then call join(inlist,descfile,tolist)
else call join(descfile,inlist,tolist)
return 0
wrap_line:
text=arg(1)
right_edge=arg(2) /* line length */
left_edge=arg(3) /* margin */
new_text=''
do while length(text) > 0
broken_word=0
if length(text) < right_edge then do
new_text=new_text || text || '0a'x
text=''
end;else do
temp_text=strip(text,l)
diff=length(text) - length(temp_text)
first_break=lastpos(' ',temp_text,right_edge - diff)
break_point=first_break + diff
if left_edge=break_point then do
break_point=right_edge - 1
broken_word=1
end
new_text=new_text || strip(left(text,break_point),t)
if broken_word then do
new_text=new_text || '-'
end
new_text=new_text || '0a'x
text=copies(' ',left_edge) || strip(right(text,length(text) - break_point),l)
end
end
return new_text
/*
join -- a 'front end' for join. Fixes a problem with join.
uses a tempfile if target filename is same as one to cat
*/
join:
x=arg(1)' 'arg(2)' 'arg(3)
temp='arexxtempfile'
do i=1 to (words(x)-1)
if word(x,i)=word(x,words(x)) then do
oops=word(x,words(x))
x=delword(x,words(x))||'TO '||temp
address COMMAND 'Join' x
address COMMAND 'Copy 'temp' 'oops
call delete(temp)
return 0
end
end
x=arg(1)' 'arg(2)' TO 'arg(3)
address COMMAND 'Join' x
return 0
addslash:
curr=arg(1)
select
when right(curr, 1)=":" then nop
when right(curr, 1)="/" then nop
otherwise curr=curr"/"
end
return curr
/* a useful procedure by Walt Sullivan */
dequote:
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~= "" then return unq_thing
return thing
halt:
ioerr:
break_c:
break_d:
call writech(stdout,cr)
call cleanup()
exit 10